home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / ICONX_FO / FMATH.C < prev    next >
Text File  |  1990-03-02  |  5KB  |  295 lines
  1.  
  2. /*
  3.  * fmath.c -- sin, cos, tan, acos, asin, atan, dtor, rtod, exp, log, sqrt
  4.  */
  5.  
  6. #include <math.h>
  7. #include "::h:config.h"
  8. #include "::h:rt.h"
  9. #include "rproto.h"
  10.  
  11. #ifdef MathFncs
  12. /*
  13.  * The following code is operating-system dependent [@fmath.01].  Include
  14.  *  system-dependent files and declarations.
  15.  */
  16.  
  17. #if PORT
  18.    /* probably #include <errno.h> */
  19. #endif                    /* PORT */
  20.  
  21. #if AMIGA || HIGHC_386 || MACINTOSH || VMS
  22. #include <errno.h>
  23. #endif                    /* AMIGA || HIGHC_386 ... */
  24.  
  25. #if ATARI_ST
  26. #if LATTICE
  27. #include <error.h>
  28. #else                    /* LATTICE */
  29. #include <errno.h>
  30. #endif                    /* LATTICE */
  31. #endif                    /* ATARI_ST */
  32.  
  33. #if MSDOS
  34. #if !MWC
  35. #include <errno.h>
  36. #endif                    /* !MWC */
  37. #if MICROSOFT
  38. int errno;
  39. #endif                    /* MICROSOFT */
  40. #endif                    /* MSDOS */
  41.  
  42. #if OS2
  43. #if MICROSOFT
  44. int errno;
  45. #endif                    /* MICROSOFT */
  46. #endif                    /* OS2 */
  47.  
  48. #if MVS || VM
  49. #include <errno.h>
  50. #ifdef SASC
  51. #include <lcmath.h>
  52. #define PI M_PI
  53. #endif                    /* SASC */
  54. #endif                    /* MVS || VM */
  55.  
  56. #if UNIX
  57. #include <errno.h>
  58. int errno;
  59. #endif                    /* UNIX */
  60.  
  61. /*
  62.  * End of operating-system specific code.
  63.  */
  64.  
  65. #ifndef PI
  66. #define PI 3.14159
  67. #endif                    /* PI */
  68.  
  69. #ifdef PreProcess
  70. /* include(../M4/fncs.m4) /* */
  71. /* */
  72. #endif                    /* PreProcess */
  73.  
  74. /*
  75.  * sin(x), x in radians
  76.  */
  77.  
  78. FncDcl(sin,1)
  79.    {
  80.    int t;
  81.    double sin();
  82.  
  83.    if ((t = cvreal(&Arg1)) == CvtFail) 
  84.      RunErr(102, &Arg1);
  85.    if (makereal(sin(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
  86.       RunErr(0, NULL);
  87.    Return;
  88.    }
  89.  
  90. /*
  91.  * cos(x), x in radians
  92.  */
  93.  
  94. FncDcl(cos,1)
  95.    {
  96.    int t;
  97.  
  98.    if ((t = cvreal(&Arg1)) == CvtFail) 
  99.       RunErr(102, &Arg1);
  100.    if (makereal(cos(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
  101.       RunErr(0, NULL);
  102.    Return;
  103.    }
  104.  
  105. /*
  106.  * tan(x), x in radians
  107.  */
  108.  
  109. FncDcl(tan,1)
  110.    {
  111.    int t;
  112.    double y;
  113.  
  114.    if ((t = cvreal(&Arg1)) == CvtFail) 
  115.       RunErr(102, &Arg1);
  116.    errno = 0;
  117.    y = tan(BlkLoc(Arg1)->realblk.realval);
  118.    if (errno == ERANGE) 
  119.       RunErr(-204, NULL);
  120.    if (makereal(y, &Arg0) == Error) 
  121.       RunErr(0, NULL);
  122.    Return;
  123.    }
  124.  
  125. /*
  126.  * acos(x), x in radians
  127.  */
  128. FncDcl(acos,1)
  129.    {
  130.    int t;
  131.    double r, y;
  132.  
  133.    if ((t = cvreal(&Arg1)) == CvtFail) 
  134.       RunErr(102, &Arg1);
  135.    r = BlkLoc(Arg1)->realblk.realval;
  136.    if (r < -1.0 || r > 1.0)        /* can't count on library */
  137.       RunErr(205,&Arg1);
  138.    errno = 0;
  139.    y = acos(r);
  140.    if (errno == EDOM) 
  141.       RunErr(-205, NULL);
  142.    if (makereal(y, &Arg0) == Error) 
  143.       RunErr(0, NULL);
  144.    Return;
  145.    }
  146.  
  147. /*
  148.  * asin(x), x in radians
  149.  */
  150. FncDcl(asin,1)
  151.    {
  152.    int t;
  153.    double r, y;
  154.  
  155.    if ((t = cvreal(&Arg1)) == CvtFail) 
  156.       RunErr(102, &Arg1);
  157.    r = BlkLoc(Arg1)->realblk.realval;
  158.    if (r < -1.0 || r > 1.0)        /* can't count on library */
  159.       RunErr(205,&Arg1);
  160.    errno = 0;
  161.    y = asin(r);
  162.    if (errno == EDOM) 
  163.       RunErr(-205, NULL);
  164.    if (makereal(y, &Arg0) == Error) 
  165.       RunErr(0, NULL);
  166.    Return;
  167.    }
  168.  
  169. /*
  170.  * atan(x,y) -- x,y  in radians; if y is present, produces atan2(x,y).
  171.  */
  172. FncDcl(atan,2)
  173.    {
  174.    int t;
  175.  
  176.    if ((t = cvreal(&Arg1)) == CvtFail) 
  177.       RunErr(102, &Arg1);
  178.    if (ChkNull(Arg2)) {
  179.       if (makereal(atan(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
  180.          RunErr(0, NULL);
  181.       }
  182.    else {
  183.       if ((t = cvreal(&Arg2)) == CvtFail) 
  184.          RunErr(102, &Arg2);
  185.       if (makereal(atan2(BlkLoc(Arg1)->realblk.realval,
  186.                BlkLoc(Arg2)->realblk.realval), &Arg0) == Error) 
  187.          RunErr(0, NULL);
  188.       }
  189.    Return;
  190.    }
  191.  
  192. /*
  193.  * dtor(x), x in degrees
  194.  */
  195.  
  196. FncDcl(dtor,1)
  197.    {
  198.  
  199.    if (cvreal(&Arg1) == CvtFail) 
  200.       RunErr(102, &Arg1);
  201.    if (makereal(BlkLoc(Arg1)->realblk.realval * PI / 180, &Arg0) == Error) 
  202.       RunErr(0, NULL);
  203.    Return;
  204.    }
  205.  
  206. /*
  207.  * rtod(x), x in radians
  208.  */
  209. FncDcl(rtod,1)
  210.    {
  211.  
  212.    if (cvreal(&Arg1) == CvtFail) 
  213.       RunErr(102, &Arg1);
  214.    if (makereal(BlkLoc(Arg1)->realblk.realval * 180 / PI, &Arg0) == Error) 
  215.       RunErr(0, NULL);
  216.    Return;
  217.    }
  218.  
  219. /*
  220.  * exp(x)
  221.  */
  222.  
  223. FncDcl(exp,1)
  224.    {
  225.    int t;
  226.    double y;
  227.  
  228.    if ((t = cvreal(&Arg1)) == CvtFail) 
  229.       RunErr(102, &Arg1);
  230.    errno = 0;
  231.    y = exp(BlkLoc(Arg1)->realblk.realval);
  232.    if (errno == ERANGE) 
  233.       RunErr(-204, NULL);
  234.    if (makereal(y, &Arg0) == Error) 
  235.       RunErr(0, NULL);
  236.    Return;
  237.    }
  238.  
  239. /*
  240.  * log(x,b) - logarithm of x to base b.
  241.  */
  242. FncDcl(log,2)
  243.    {
  244.    static double lastbase = 0.0;
  245.    static double divisor;
  246.    double x;
  247.  
  248.    if (cvreal(&Arg1) != T_Real)
  249.       RunErr(102, &Arg1);
  250.    if (BlkLoc(Arg1)->realblk.realval <= 0.0)
  251.       RunErr(205, &Arg1);
  252.    x = log(BlkLoc(Arg1)->realblk.realval);
  253.    if (! ChkNull(Arg2))  {
  254.       if (cvreal(&Arg2) != T_Real)
  255.          RunErr(102, &Arg2);
  256.       if (BlkLoc(Arg2)->realblk.realval <= 1.0)
  257.          RunErr(205, &Arg2);
  258.       if (BlkLoc(Arg2)->realblk.realval != lastbase) {
  259.          divisor = log(BlkLoc(Arg2)->realblk.realval);
  260.          lastbase = BlkLoc(Arg2)->realblk.realval;
  261.          }
  262.       x = x / divisor;
  263.       }  
  264.    if (makereal(x, &Arg0) == Error)
  265.       RunErr(0, NULL);
  266.    Return;
  267.    }
  268.  
  269.  
  270. /*
  271.  * sqrt(x)
  272.  */
  273.  
  274. FncDcl(sqrt,1)
  275.    {
  276.    int t;
  277.    double r, y;
  278.  
  279.    if ((t = cvreal(&Arg1)) == CvtFail) 
  280.       RunErr(102, &Arg1);
  281.    r = BlkLoc(Arg1)->realblk.realval;
  282.    if (r < 0)
  283.       RunErr(205, &Arg1);
  284.    y = sqrt(r);
  285.    errno = 0;
  286.    if (errno == EDOM) 
  287.       RunErr(-205, NULL);
  288.    if (makereal(y, &Arg0) == Error) 
  289.       RunErr(0, NULL);
  290.    Return;
  291.    }
  292. #else                    /* MathFncs */
  293. static char x;            /* prevent empty module */
  294. #endif                    /* MathFncs */
  295.